home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 5 / DISK2058.ZIP / UNFAST.EXE / RKEY.F < prev    next >
Text File  |  1980-01-01  |  8KB  |  477 lines
  1. ;KEY redifinition program.
  2. ;
  3. ; RKEY    Written by Peter Campbell 1988.
  4. ;
  5.  
  6. const maxk=32500/3,defk=1000
  7. var place,start,nextk,s,keys,m,main,kseg,sh
  8. var ax,retax,running,defining,kspace,playback
  9.  
  10. #window memory 4000
  11. #inpend=0
  12.  
  13. on error
  14.     {
  15.     print bios
  16.     error msg "\dos.err"
  17.     terminate
  18.     }
  19.  
  20. proc loadfile
  21.     {
  22.     nextk=(read #1,kspace to kseg|0)/3
  23.     if error then nextk=0:print bios " <error>";
  24.     close #1
  25.     }
  26.  
  27. proc incy
  28.     {
  29.     y++
  30.     while peekb 0|417h and 8 {}
  31.     if y=24 then scroll 1,3,69,23,1:y=23
  32.     locate y,15
  33.     }
  34.  
  35. print bios cr;lf"RKEY by Peter Campbell. v2"
  36. keys=defk
  37. dseg=peek 0|86h
  38.  
  39. proc eshift
  40.     {
  41.     if sh and 8 then print "ALT-";
  42.     if sh and 4 then print "CTRL-";
  43.     if sh and 2 then print "LSHIFT-";
  44.     if sh and 1 then print "RSHIFT-";
  45.     }
  46.  
  47. proc escan
  48.     {
  49.     l=low ax:ax=high ax
  50.     if ax>132 then print "<?>";
  51.     else
  52.     {
  53.     c=peekb(kbase+ax)
  54.     if (c>20) and (l>31) then print chr l;
  55.     else
  56.         {
  57.         if c<21 then
  58.         {
  59.         a=(searchb 2000 from ebase for c)+1
  60.         while peekb a<>255
  61.             {
  62.             if main and ((peekb a='<') or (peekb a='>')) then goto incm
  63.             print chr peekb a;
  64.             incm:
  65.             a++
  66.             }
  67.         }
  68.         else
  69.         {
  70.         print chr c;
  71.         }
  72.         }
  73.     }
  74.     }
  75.  
  76. function found
  77.     {
  78.     mem=0
  79.     shift=(peek 0|417h) and 15
  80.     while mem<(nextk*3)
  81.     {
  82.     if (retax=kseg[mem]) and (shift=kseg[mem+2]b) then
  83.         {
  84.         address=mem+6
  85.         finish=kseg[mem+3]
  86.         return 1
  87.         }
  88.     mem=kseg[mem+3]
  89.     }
  90.     return 0
  91.     }
  92.  
  93. proc process
  94.     {
  95.     if running and (not defining) and (not playback) then
  96.     {
  97.     if found then playback=1
  98.     }
  99.     }
  100.  
  101. x=81h
  102.  
  103. forever
  104. {
  105. while peekb x=' ' x++
  106. if peekb x=13 then goto startm
  107. if peekb x='/' then
  108.     {
  109.     x++:keys=0
  110.  
  111.     loopm:
  112.     c=peekb x-'0'
  113.     if (c<0) or (c>9) then goto exitm
  114.     keys*=10
  115.     keys+=c
  116.     x++
  117.     goto loopm
  118.  
  119.     exitm:
  120.     if keys<100 then keys=100
  121.     if keys>maxk then keys=maxk
  122.     }
  123. else
  124.     {
  125.     m=name
  126.     while (peekb x<>13) and (peekb x<>' ')
  127.     {
  128.     pokeb m,ucase peekb x
  129.     x++:m++
  130.     }
  131.     pokeb m,0
  132.     }
  133. }
  134.  
  135. startm:
  136. kseg=allocate ((keys*3)+15)/16
  137. kspace=keys*3:nextk=0
  138. fillb kspace from kseg|0 with 0
  139.  
  140. if peekb name then
  141.     {
  142.     print bios "  Using file: ";
  143.     m=name
  144.     while peekb m print bios chr peekb m;:m++
  145.     open #1,name
  146.     loadfile
  147.     }
  148. print bios "  "keys" keys."
  149. print bios "Installed!"
  150.  
  151. dos 35(16)
  152. poke oseg,reg es:poke ooff,reg bx
  153. reg dx=new16:dos 25(16)
  154.  
  155. running=1
  156. playback=0
  157. defining=0
  158. translate=1
  159. internal=0
  160.  
  161. stop resident
  162.  
  163. another:
  164. inline 9dh
  165. popall
  166.  
  167. new16:
  168. enable interupts
  169. pushall
  170.  
  171. push reg ax
  172.  
  173. inline 2eh
  174. if playback then
  175.     {
  176.     reg ds=reg cs
  177.     nz++
  178.     pop ff
  179.     inline 9ch
  180.     retax=kseg[address]
  181.     if (high ff<>0) and (high ff<>16) then goto play16
  182.     address+=3
  183.     if address>=finish then playback=0
  184.     goto play16
  185.     }
  186.  
  187. inline 58h
  188. push reg ax
  189. inline 9ch,2eh,9ah ; CALLF CS:[old int 16h]
  190. ooff:
  191. data 0
  192. oseg:
  193. data 0
  194.  
  195. inline 2eh
  196. retax=reg ax
  197. reg ds=reg cs
  198. pop ff
  199. inline 9ch
  200.  
  201. play16:
  202. if internal then goto ret16
  203. if (high ff<>0) and (high ff<>16) then goto ret16
  204.  
  205. if defining and (retax<>1) then
  206.     {
  207.     ad=place*3
  208.     if ad>=kspace then beep:defining=0:goto enddef
  209.     kseg[ad]=retax
  210.     kseg[ad+2]b=(peek 0|417h) and 15
  211.     if place=start then
  212.     {
  213.     if found then
  214.         {
  215.         ;Delete old definition.
  216.         moveb kspace-finish from kseg|finish to kseg|mem
  217.         d=finish-mem
  218.         nextk-=d/3
  219.         while (mem/3)<=nextk
  220.         {
  221.         kseg[mem+3]-=d
  222.         mem=kseg[mem+3]
  223.         }
  224.         }
  225.     place=nextk+2:start=nextk
  226.     goto another
  227.     }
  228.     place++
  229.     goto ret16
  230.     }
  231.  
  232. if not translate then
  233.     {
  234.     translate=1
  235.     goto ret16
  236.     }
  237.  
  238. p=playback:process:if p<>playback then goto another
  239.  
  240. if retax=111 then internal=1
  241.  
  242. if not running then goto check_toggle
  243.  
  244. if retax=1 then
  245.     {
  246.     if defining then
  247.     {
  248.     enddef:
  249.     cursor size 6+6*mono,7+6*mono
  250.     ad=(start+1)*3
  251.     kseg[ad]=place*3 ; Set start address for next keydef.
  252.     if place>nextk+2 then nextk=place ; else no definition.
  253.     defining=0
  254.     }
  255.     else
  256.     {
  257.     cursor size 0,7+6*mono
  258.     defining=1
  259.     place=nextk
  260.     start=nextk
  261.     }
  262.     goto another
  263.     }
  264.  
  265. if retax=7 then
  266.     {
  267.     if dseg<>reg ss
  268.     then gosub functions
  269.     else for a=400 to 5000:noise 2,a:next a:noise off
  270.     goto another
  271.     }
  272.  
  273. if retax=4 then
  274.     {
  275.     translate=0
  276.     goto another
  277.     }
  278.  
  279. check_toggle:
  280. if retax=9 then
  281.     {
  282.     running=not running ; Toggle running mode.
  283.     goto another
  284.     }
  285.  
  286. ret16:
  287. inline 9dh
  288. popall
  289. inline 2eh
  290. reg ax=retax
  291. inline 0cah,2,0 ; RETF 0002
  292.  
  293.  
  294. functions:
  295. video=(0b800h-(800h*mono))+page*100h
  296. internal=1
  297. pokeb funct+1,0:open window funct:pokeb funct+1,4
  298. colour 7:locate 13,32:print "> "keys-nextk" free.";
  299.  
  300. x=1
  301. forever
  302.     {
  303.     x=select funct,x
  304.     if not x then internal=0:close window:return
  305.     colour 78h
  306.  
  307.     if x=1 then
  308.     {
  309.     open window help
  310.     wait for keyscan
  311.     close window
  312.     }
  313.  
  314.     if x=2 then
  315.     {
  316.     open window namew
  317.     oc=curpos
  318.     locate 10,42:print "Load:"
  319.     locate 13,42:print "(Press ESC or ENTER to abort)"
  320.     cursor 12,42:print bios "> ";
  321.     inputs iname
  322.     curpos=oc
  323.     close window
  324.     if peekb (iname+2)=0 then goto nextm
  325.     #errors off
  326.     open #1,iname+2
  327.     #errors on
  328.     if error then beep:beep
  329.     else
  330.         {
  331.         move 32 from iname+2 to name
  332.         loadfile
  333.         }
  334.     }
  335.  
  336.     if x=3 then
  337.     {
  338.     open window namew
  339.     locate 10,42:print "Save: "
  340.     locate 12,42:print "> ";
  341.     m=name:while peekb m print chr ucase peekb m;:m++
  342.     oc=curpos
  343.     cursor 12,42
  344.     if nextk=0 then
  345.         {
  346.         print bios "No keys to save, press ESC!"
  347.         wait for key=27
  348.         goto exitsave
  349.         }
  350.     if peekb name=0 then
  351.         {
  352.         print bios "Save name > ";
  353.         inputs iname
  354.         if peekb (iname+2)=0 then goto exitsave
  355.         move 32 from iname+2 to name
  356.         }
  357.  
  358.     #errors off
  359.     save name,kseg|0,nextk*3
  360.     #errors on
  361.     if error then beep:beep
  362.  
  363.     exitsave:
  364.     curpos=oc
  365.     close window
  366.     }
  367.  
  368.     if x=4 then
  369.     {
  370.     open window viewm
  371.     km=0:y=2:colour 7
  372.  
  373.     while km<nextk
  374.         {
  375.         incy
  376.         ad=km*3:ax=kseg[ad]:sh=kseg[ad+2]b
  377.         main=1:locate y,2:eshift:escan:main=0
  378.         locate y,15
  379.         finish=kseg[ad+3]
  380.         km+=2
  381.         while km*3<finish
  382.         {
  383.         if (locpos mod 160)>120 then
  384.             {
  385.             incy
  386.             }
  387.         a=0
  388.         ax=kseg[km*3]:escan
  389.         if a=edb then incy
  390.         km++
  391.         }
  392.         }
  393.  
  394.     wait for keyscan
  395.     close window
  396.     }
  397.  
  398.     nextm:
  399.     }
  400.  
  401. viewm:
  402. datab 1,0,0,0,70,24,7
  403. datab 22,2,1,'KEY'
  404. datab 22,15,1,'EXPANSION'
  405. datab 26
  406.  
  407. funct:
  408. datab 1,4,30,6,49,14,1fh
  409. datab 22,3,1,'RKEY FUNCTIONS'
  410. datab 22,2,3,'Help'
  411. datab 22,2,4,'Load keys'
  412. datab 22,2,5,'Save keys'
  413. datab 22,2,6,'View keys'
  414. datab 26
  415.  
  416. help:
  417. datab 1,0,0,13,79,24,60h
  418. datab 22,2,1,'RKEY  Key:    Function:'
  419. datab 22,8,3,       'ALT-1   Start/stop key definition.'
  420. datab 22,8,5,       'ALT-7   RKEY function menu. HELP/LOAD/SAVE/VIEW'
  421. datab 22,8,5,       'ALT-4   Ignores translation of next key.'
  422. datab 22,8,6,       'ALT-9   Activate/Deactivate RKEY.'
  423. datab 22,8,7,       'ALT-111 Abort RKEY (removes RKEY from memory).'
  424. datab 22,2,9,'Note: The number after ALT must be typed using the keypad and'
  425. datab            ' with the'
  426. datab 22,8,10,        'ALT key pressed all the time - release ALT to work.'
  427. datab 26
  428.  
  429. namew:
  430. datab 0,0,40,8,79,15,78h,26
  431.  
  432. iname:
  433. string 20
  434.  
  435. kbase:
  436. datab 20,0,'1234567890-='
  437. datab 1,2,'qwertyuiop[]',3
  438. datab 20,'asdfghjkl;''`',20,'\zxcvbnm,./',20,'*',20,' ',20
  439. datab 4,5,6,7,8,9,10,11,12,13,20,20
  440. datab 14,24,15,'-',27,20,26,'+'
  441. datab 16,25,17,18,19
  442. datab 4,5,6,7,8,9,10,11,12,13
  443. datab 4,5,6,7,8,9,10,11,12,13
  444. datab 4,5,6,7,8,9,10,11,12,13
  445. datab 20,27,26,16,17,14
  446. datab '1234567890-=',15
  447.  
  448. ebase:
  449. datab 0,'<esc>',255
  450. datab 1,'<backspace>',255
  451. datab 2,'<tab>',255
  452.  
  453. datab 3,'<enter>'
  454. edb:
  455. datab 255
  456.  
  457. datab 4,'<F1>',255
  458. datab 5,'<F2>',255
  459. datab 6,'<F3>',255
  460. datab 7,'<F4>',255
  461. datab 8,'<F5>',255
  462. datab 9,'<F6>',255
  463. datab 10,'<F7>',255
  464. datab 11,'<F8>',255
  465. datab 12,'<F9>',255
  466. datab 13,'<F10>',255
  467. datab 14,'<home>',255
  468. datab 15,'<PgUp>',255
  469. datab 16,'<end>',255
  470. datab 17,'<PgDn>',255
  471. datab 18,'<ins>',255
  472. datab 19,'<del>',255
  473. datab 20,'<?>',255
  474.  
  475. name:
  476. space 64
  477.